home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / OWNRDRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  4KB  |  122 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program OwnerDrawDemo;
  10.  
  11. uses WinTypes, WinProcs, WObjects, Strings;
  12.  
  13. const
  14.   id_Button = 100;
  15.  
  16. type
  17.   POwnerDrawButton = ^TOwnerDrawButton;
  18.   TOwnerDrawButton = object(TButton)
  19.     constructor Init(AParent: PWindowsObject; AnId: Integer; AText: PChar;
  20.       X, Y, W, H: Integer; IsDefault: Boolean);
  21.     procedure DrawButton(DC: HDC; R: TRect); virtual;
  22.     procedure DrawFocused(DC: HDC; R: TRect); virtual;
  23.     procedure DrawPushed(DC: HDC; R: TRect); virtual;
  24.     procedure DrawSelf(DrawItemStruct: PDrawItemStruct);
  25.   end;
  26.  
  27.   PDemoWindow = ^TDemoWindow;
  28.   TDemoWindow = object(TWindow)
  29.     Button: POwnerDrawButton;
  30.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  31.     procedure ButtonPushed(var Message: TMessage);
  32.       virtual id_First + id_Button;
  33.     procedure WMDrawItem(var Message: TMessage);
  34.       virtual WM_DrawItem;
  35.   end;
  36.  
  37.   TApp = object(TApplication)
  38.     procedure InitMainWindow; virtual;
  39.   end;
  40.  
  41.  
  42. {TOwnerDrawButton}
  43. constructor TOwnerDrawButton.Init(AParent: PWindowsObject; AnId: Integer;
  44.   AText: PChar; X, Y, W, H: Integer; IsDefault: Boolean);
  45. begin
  46.   TButton.Init(AParent, AnId, AText, X, Y, W, H, IsDefault);
  47.   Attr.Style := Attr.Style or bs_OwnerDraw;
  48. end;
  49.  
  50. procedure TOwnerDrawButton.DrawButton(DC: HDC; R: TRect);
  51. var
  52.   Brush: HBrush;
  53. begin
  54.   Brush := SelectObject(DC, CreateSolidBrush(RGB($ff,0,0)));
  55.   Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
  56.   SetBkMode(DC, Transparent);
  57.   DrawText(DC, 'Push', 4, R, dt_Center or dt_VCenter or dt_SingleLine);
  58.   DeleteObject(SelectObject(DC, Brush));
  59. end;
  60.  
  61. procedure TOwnerDrawButton.DrawFocused(DC: HDC; R: TRect);
  62. begin
  63.   Rectangle(DC, R.Left + 1, R.Top + 1, R.Right - 1, R.Bottom - 1);
  64. end;
  65.  
  66. procedure TOwnerDrawButton.DrawPushed(DC: HDC; R: TRect);
  67. var
  68.   Brush: HBrush;
  69. begin
  70.   Brush := SelectObject(DC, CreateSolidBrush(RGB($80,0,0)));
  71.   Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom);
  72.   SetBkMode(DC, Transparent);
  73.   DrawText(DC, 'Pushed', 6, R, dt_Center or dt_VCenter or dt_SingleLine);
  74.   DeleteObject(SelectObject(DC, Brush));
  75. end;
  76.  
  77. procedure TOwnerDrawButton.DrawSelf(DrawItemStruct: PDrawItemStruct);
  78. begin
  79.   with DrawItemStruct^ do
  80.   begin
  81.     if (itemState and ods_Selected) = 0 then
  82.       DrawButton(HDC, rcItem)
  83.     else
  84.       DrawPushed(HDC, rcItem);
  85.     if itemAction and oda_Focus <> 0 then
  86.       DrawFocused(HDC, rcItem);
  87.   end;
  88. end;
  89.  
  90. {TDemoWindow}
  91. constructor TDemoWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  92. begin
  93.   TWindow.Init(AParent, ATitle);
  94.   Button := New(POwnerDrawButton, Init(@Self, id_Button, 'Draw',
  95.     10, 10, 80, 30, True));
  96. end;
  97.  
  98. procedure TDemoWindow.ButtonPushed(var Message: TMessage);
  99. begin
  100.   MessageBox(HWindow, 'Button Pushed', 'Message', mb_Ok);
  101. end;
  102.  
  103. procedure TDemoWindow.WMDrawItem(var Message: TMessage);
  104. begin
  105.   if PDrawItemStruct(Message.lParam)^.CtlId = id_Button then
  106.     Button^.DrawSelf(PDrawItemStruct(Message.lParam));
  107. end;
  108.  
  109. {TApp}
  110. procedure TApp.InitMainWindow;
  111. begin
  112.   MainWindow := New(PDemoWindow, Init(Nil, 'Owner Draw Button Demo'));
  113. end;
  114.  
  115. var
  116.   App: TApp;
  117.  
  118. begin
  119.   App.Init('Demo');
  120.   App.Run;
  121.   App.Done;
  122. end.